home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr26 / 4utils73.zip / STRINGDA.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-01  |  14KB  |  567 lines
  1. UNIT StringDateHandling;
  2. {$D-,F+} (* I'am using procedural variables! *)
  3. (* ----------------------------------------------------------------------
  4.    Part of 4DESC - A Simple 4DOS File Description Editor
  5.        and 4FF   - 4DOS File Finder
  6.  
  7.        David Frey,         & Tom Bowden
  8.        Urdorferstrasse 30    1575 Canberra Drive
  9.        8952 Schlieren ZH     Stone Mountain, GA 30088-3629
  10.        Switzerland           USA
  11.  
  12.        Code created using Turbo Pascal 7.0, (c) Borland International 1992
  13.  
  14.    DISCLAIMER: This unit is freeware: you are allowed to use, copy
  15.                and change it free of charge, but you may not sell or hire
  16.                this part of 4DESC. The copyright remains in our hands.
  17.  
  18.                If you make any (considerable) changes to the source code,
  19.                please let us know. (send a copy or a listing).
  20.                We would like to see what you have done.
  21.  
  22.                We, David Frey and Tom Bowden, the authors, provide absolutely
  23.                no warranty of any kind. The user of this software takes the
  24.                entire risk of damages, failures, data losses or other
  25.                incidents.
  26.  
  27.  
  28.        Code created using Turbo Pascal 6.0 (c) Borland International 1990
  29.  
  30.    This unit provides the string handling and the date/time handling.
  31.  
  32.    ----------------------------------------------------------------------- *)
  33.  
  34. INTERFACE USES Dos;
  35.  
  36. TYPE  DateStr    = STRING[8];  (* 'mm-dd-yy','dd.mm.yy' or 'yy/mm/dd' *)
  37.       TimeStr    = STRING[6];  (* 'hh:mmp' or 'hh:mm'                 *)
  38.  
  39. VAR   DateFormat: DateStr; (* 'mm-dd-yy','dd.mm.yy','yy/mm/dd' or 'ddmmmyy' *)
  40.       TimeFormat: TimeStr; (* 'hh:mmp' or 'hh:mm'                           *)
  41.  
  42. (* String handling routines. The strings can be converted to lower/upper-
  43.    case. National characters will be converted.                           *)
  44.  
  45. FUNCTION  Chars(c: CHAR; Count: BYTE): STRING;
  46. FUNCTION  DownCase(C: CHAR): CHAR;
  47. FUNCTION  DownStr(s: STRING): STRING;
  48. PROCEDURE DownString(VAR s: STRING);
  49. FUNCTION  UpStr(s: STRING): STRING;
  50. PROCEDURE UpString(VAR s: STRING);
  51.  
  52. PROCEDURE StripLeadingSpaces(VAR s: STRING);
  53. PROCEDURE StripTrailingSpaces(VAR s: STRING);
  54.  
  55. (* Date/Time handling routines. Date/Time and Numbers will be formatted
  56.    in accordance with your COUNTRY=-settings in CONFIG.SYS.               *)
  57.  
  58. TYPE  FormDateFunc = FUNCTION (DateRec: DateTime) : DateStr;
  59.       FormTimeFunc = FUNCTION (DateRec: DateTime) : TimeStr;
  60.  
  61. VAR   FormDate : FormDateFunc;
  62.       FormTime : FormTimeFunc;
  63.  
  64.  
  65. FUNCTION FormattedIntStr(nr: WORD;minlength: BYTE): STRING;
  66. FUNCTION FormattedLongIntStr(nr: LONGINT;minlength: BYTE): STRING;
  67.  
  68. IMPLEMENTATION USES HandleINIFile;
  69.  
  70. CONST MonthName: ARRAY[1..12] OF STRING[3] =
  71.                   ('Jan','Feb','Mar','Apr','May','Jun',
  72.                    'Jul','Aug','Sep','Oct','Nov','Dec');
  73.  
  74. CONST DateSep  : CHAR = '.';
  75.       TimeSep  : CHAR = ':';
  76.       MilleSep : CHAR = '''';
  77.  
  78. VAR   Buffer: ARRAY[0..15] OF CHAR;
  79.       (* Buffer for country code information.
  80.          This buffer may not be moved into GetCountryInfo,
  81.          since MS-DOS needs the address of this buffer!    *)
  82.  
  83. (*-------------------------------------------------------- String-Handling *)
  84. FUNCTION Chars(c: CHAR; Count: BYTE): STRING; ASSEMBLER;
  85.  
  86. ASM
  87.  LES DI,@Result
  88.  MOV AL,&Count
  89.  CLD
  90.  STOSB
  91.  MOV CL,AL
  92.  XOR CH,CH
  93.  MOV AL,&c
  94.  REP STOSB
  95. END;
  96.  
  97. FUNCTION  DownCase(C: CHAR): CHAR; ASSEMBLER;
  98.  
  99. ASM
  100.   MOV AL,&c
  101.   CMP AL,'A'
  102.   JB  @@9                  (* No conversion below 'A'                     *)
  103.   CMP AL,'Z'
  104.   JA  @@1                  (* Conversion between 'A' and 'Z'              *)
  105.   ADD AL,$20
  106.   JMP @@9                  (* finished. *)
  107. @@1: CMP AL,'Ä'
  108.   JNZ @@2
  109.   MOV AL,'ä'
  110.   JMP @@9
  111. @@2:
  112.   CMP AL,'Ö'
  113.   JNZ @@3
  114.   MOV AL,'ö'
  115.   JMP @@9
  116. @@3:
  117.   CMP AL,'Ü'
  118.   JNZ @@4                  (* No conversion at all                        *)
  119.   MOV AL,'ü'
  120.   JMP @@9
  121. @@4:
  122.   CMP AL,'É'
  123.   JNZ @@5
  124.   MOV AL,'é'
  125.   JMP @@9
  126. @@5:
  127.   CMP AL,'Ç'
  128.   JNZ @@6
  129.   MOV AL,'ç'
  130.   JMP @@9
  131. @@6:
  132.   CMP AL,'Å'
  133.   JNZ @@7
  134.   MOV AL,'å'
  135.   JMP @@9
  136. @@7:
  137.   CMP AL,'Ñ'
  138.   JNZ @@9                  (* No conversion at all *)
  139.   MOV AL,'ñ'
  140. @@9:
  141. END;
  142.  
  143. FUNCTION  DownStr(s: STRING): STRING; ASSEMBLER;
  144.  
  145. ASM
  146.  PUSH DS
  147.  CLD
  148.  LDS SI,s
  149.  LES DI,@Result
  150.  LODSB
  151.  STOSB
  152.  XOR AH,AH
  153.  XCHG AX,CX
  154.  JCXZ @11
  155. @10:
  156.  LODSB
  157.  CMP AL,'A'
  158.  JB  @@9                  (* No conversion below 'A'                     *)
  159.  CMP AL,'Z'
  160.  JA  @@1                  (* Conversion between 'A' and 'Z'              *)
  161.  ADD AL,$20
  162.  JMP @@9                  (* finished. *)
  163. @@1: CMP AL,'Ä'
  164.  JNZ @@2
  165.  MOV AL,'ä'
  166.  JMP @@9
  167. @@2:
  168.  CMP AL,'Ö'
  169.  JNZ @@3
  170.  MOV AL,'ö'
  171.  JMP @@9
  172. @@3:
  173.  CMP AL,'Ü'
  174.  JNZ @@4
  175.  MOV AL,'ü'
  176.  JMP @@9
  177. @@4:
  178.  CMP AL,'É'
  179.  JNZ @@5
  180.  MOV AL,'é'
  181.  JMP @@9
  182. @@5:
  183.  CMP AL,'Ç'
  184.  JNZ @@6
  185.  MOV AL,'ç'
  186.  JMP @@9
  187. @@6:
  188.  CMP AL,'Å'
  189.  JNZ @@7
  190.  MOV AL,'å'
  191.  JMP @@9
  192. @@7:
  193.  CMP AL,'Ñ'
  194.  JNZ @@9                  (* No conversion at all                        *)
  195.  MOV AL,'ñ'
  196. @@9:
  197.  STOSB
  198.  LOOP @10
  199. @11:
  200.  POP DS
  201. END;
  202.  
  203.  
  204. PROCEDURE DownString(VAR s: STRING);
  205.  
  206. VAR i : BYTE;
  207.  
  208. BEGIN
  209.  FOR i := 1 TO Length(s) DO s[i] := DownCase(s[i]);
  210. END;
  211.  
  212.  
  213. FUNCTION  UpStr(s: STRING): STRING; ASSEMBLER;
  214.  
  215. ASM
  216.  PUSH DS
  217.  CLD
  218.  LDS SI,s
  219.  LES DI,@Result
  220.  LODSB
  221.  STOSB
  222.  XOR AH,AH
  223.  XCHG AX,CX
  224.  JCXZ @11
  225. @10:
  226.  LODSB
  227.  CMP AL,'a'
  228.  JB @@9
  229.  CMP AL,'z'
  230.  JA @@1
  231.  SUB AL,20H
  232.  JMP @@9
  233. @@1: CMP AL,'ä'
  234.   JNZ @@2
  235.   MOV AL,'Ä'
  236.   JMP @@9
  237. @@2:
  238.   CMP AL,'ö'
  239.   JNZ @@3
  240.   MOV AL,'Ö'
  241.   JMP @@9
  242. @@3:
  243.   CMP AL,'ü'
  244.   JNZ @@4
  245.   MOV AL,'Ü'
  246.   JMP @@9
  247. @@4:
  248.   CMP AL,'é'
  249.   JNZ @@5
  250.   MOV AL,'É'
  251.   JMP @@9
  252. @@5:
  253.   CMP AL,'ç'
  254.   JNZ @@6
  255.   MOV AL,'Ç'
  256.   JMP @@9
  257. @@6:
  258.   CMP AL,'å'
  259.   JNZ @@7
  260.   MOV AL,'Å'
  261.   JMP @@9
  262. @@7:
  263.   CMP AL,'ñ'
  264.   JNZ @@9                  (* No conversion at all                        *)
  265.   MOV AL,'Ñ'
  266. @@9:
  267.  STOSB
  268.  LOOP @10
  269. @11:
  270.  POP DS
  271. END;
  272.  
  273. PROCEDURE UpString(VAR s: STRING);
  274.  
  275. VAR l : BYTE;
  276.  
  277. BEGIN
  278.  FOR l := 1 TO Length(s) DO s[l] := UpCase(s[l]);
  279. END;
  280.  
  281. PROCEDURE StripLeadingSpaces(VAR s: STRING);
  282.  
  283. BEGIN
  284.  WHILE s[1] = ' ' DO Delete(s,1,1);
  285. END;
  286.  
  287. PROCEDURE StripTrailingSpaces(VAR s: STRING);
  288.  
  289. VAR l : BYTE;
  290.  
  291. BEGIN
  292.  l := Length(s);
  293.  WHILE s[l] = ' ' DO BEGIN Delete(s,l,1); l := Length(s); END;
  294. END;
  295.  
  296. (*-------------------------------------------------------- Date-Handling *)
  297.  
  298. FUNCTION FormDateEuropean(DateRec: DateTime): DateStr;
  299.  
  300. VAR MonStr, DayStr, YearStr : STRING[2];
  301.     res                     : DateStr;
  302.  
  303. BEGIN
  304.  Str(DateRec.Day:2, DayStr);
  305.  
  306.  Str(DateRec.Month:2, MonStr);
  307.  IF DateRec.Month < 10 THEN MonStr[1] := '0';
  308.  
  309.  DateRec.Year := DateRec.Year MOD 100;
  310.  Str(DateRec.Year:2, YearStr);
  311.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  312.  
  313.  FormDateEuropean := DayStr + DateSep + MonStr + DateSep + YearStr;
  314. END;
  315.  
  316. FUNCTION FormDateUS(DateRec: DateTime): DateStr;
  317.  
  318. VAR MonStr, DayStr, YearStr : STRING[2];
  319.     res                     : DateStr;
  320.  
  321. BEGIN
  322.  Str(DateRec.Day:2, DayStr);
  323.  IF DateRec.Day < 10 THEN DayStr[1] := '0';
  324.  
  325.  Str(DateRec.Month:2, MonStr);
  326.  
  327.  DateRec.Year := DateRec.Year MOD 100;
  328.  Str(DateRec.Year:2, YearStr);
  329.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  330.  
  331.  FormDateUS := MonStr + DateSep + DayStr + DateSep + YearStr;
  332. END;
  333.  
  334. FUNCTION FormDateJapanese(DateRec: DateTime): DateStr;
  335.  
  336. VAR MonStr, DayStr, YearStr : STRING[2];
  337.     res                     : DateStr;
  338.  
  339. BEGIN
  340.  Str(DateRec.Day:2, DayStr);
  341.  IF (DateRec.Day < 10) THEN DayStr[1] := '0';
  342.  
  343.  Str(DateRec.Month:2, MonStr);
  344.  IF (DateRec.Month < 10) THEN MonStr[1] := '0';
  345.  
  346.  DateRec.Year := DateRec.Year MOD 100;
  347.  Str(DateRec.Year:2, YearStr);
  348.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  349.  
  350.  FormDateJapanese := YearStr + DateSep + MonStr + DateSep + DayStr;
  351. END;
  352.  
  353. FUNCTION FormDateMyOwn(DateRec: DateTime): DateStr;
  354.  
  355. VAR DayStr, YearStr : STRING[2];
  356.     res             : DateStr;
  357.  
  358. BEGIN
  359.  Str(DateRec.Day:2, DayStr);
  360.  
  361.  DateRec.Year := DateRec.Year MOD 100;
  362.  Str(DateRec.Year:2, YearStr);
  363.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  364.  
  365.  FormDateMyOwn := DayStr + MonthName[DateRec.Month] + YearStr;
  366. END;
  367.  
  368. FUNCTION FormTime12(DateRec: DateTime): TimeStr;
  369.  
  370. VAR HourStr, MinStr, SecStr : STRING[2];
  371.     amflag                  : CHAR;
  372.     res                     : TimeStr;
  373.  
  374. BEGIN
  375.  IF DateRec.Hour < 12 THEN amflag := 'a'
  376.                       ELSE BEGIN amflag := 'p'; DEC(DateRec.Hour,12); END;
  377.  Str(DateRec.Hour:2,HourStr);
  378.  Str(DateRec.Min :2,MinStr ); IF DateRec.Min < 10 THEN MinStr[1] := '0';
  379.  Str(DateRec.Sec :2,SecStr ); IF DateRec.Sec < 10 THEN SecStr[1] := '0';
  380.  
  381.  FormTime12 := HourStr + TimeSep + MinStr + amflag;
  382. END;
  383.  
  384. FUNCTION FormTime24(DateRec: DateTime): TimeStr;
  385.  
  386. VAR HourStr, MinStr, SecStr : STRING[2];
  387.     res                     : TimeStr;
  388.  
  389. BEGIN
  390.  Str(DateRec.Hour:2,HourStr);
  391.  Str(DateRec.Min :2,MinStr ); IF DateRec.Min < 10 THEN MinStr[1] := '0';
  392.  Str(DateRec.Sec :2,SecStr ); IF DateRec.Sec < 10 THEN SecStr[1] := '0';
  393.  
  394.  FormTime24 := HourStr + TimeSep + MinStr;
  395. END;
  396.  
  397. (*------------------------------------------------ Formatting of numbers *)
  398.  
  399. FUNCTION FormattedIntStr(nr: WORD;minlength: BYTE): STRING;
  400. (* Converts an integer number into a string of the form xxx'xxx...') *)
  401.  
  402. VAR helpstr  : STRING;
  403.     millestr : STRING[4];
  404.     n,i      : BYTE;
  405.  
  406. BEGIN
  407.  IF nr = 0 THEN FormattedIntStr := Chars(' ',minlength-1)+'0'
  408.  ELSE
  409.   BEGIN
  410.    helpstr := '';
  411.    n := nr DIV 1000; nr := nr MOD 1000;
  412.    IF n > 0 THEN
  413.     BEGIN
  414.      Str(n,helpstr);
  415.      helpstr := millestr+helpstr+MilleSep;
  416.     END;
  417.  
  418.    IF n = 0 THEN Str(nr,millestr)
  419.    ELSE
  420.     BEGIN
  421.      Str(nr:3,millestr);
  422.      FOR i := 1 TO 3 DO IF millestr[i] = ' ' THEN millestr[i] := '0';
  423.     END;
  424.    helpstr:=helpstr+millestr;
  425.    n := Length(helpstr);
  426.    IF n < minlength THEN helpstr := Chars(' ',minlength-n)+helpstr;
  427.  
  428.    FormattedIntStr := helpstr;
  429.   END;
  430. END;
  431.  
  432. FUNCTION FormattedLongIntStr(nr: LONGINT;minlength: BYTE): STRING;
  433. (* Converts a long integer number into a string of the form xxx'xxx...') *)
  434.  
  435. VAR helpstr  : STRING;
  436.     millestr : STRING[4];
  437.     n,i      : WORD;
  438.  
  439. BEGIN
  440.  IF nr = 0 THEN FormattedLongIntStr := Chars(' ',minlength-1)+'0'
  441.  ELSE
  442.   BEGIN
  443.    helpstr := '';
  444.  
  445.    n := nr DIV 1000000; nr := nr MOD 1000000;
  446.    IF n > 0 THEN
  447.     BEGIN
  448.      Str(n,millestr); helpstr := millestr+MilleSep;
  449.     END;
  450.  
  451.    n := nr DIV 1000; nr := nr MOD 1000;
  452.    IF n > 0 THEN
  453.     BEGIN
  454.      Str(n:3,millestr);
  455.      IF helpstr > '' THEN
  456.       BEGIN
  457.        FOR i := 1 TO 3 DO IF millestr[i] = ' ' THEN millestr[i] := '0';
  458.        helpstr := helpstr+millestr+MilleSep;
  459.       END
  460.      ELSE helpstr := millestr+MilleSep;
  461.     END;
  462.  
  463.    IF n = 0 THEN Str(nr,millestr)
  464.    ELSE
  465.     BEGIN
  466.      Str(nr:3,millestr);
  467.      FOR i := 1 TO 3 DO IF millestr[i] = ' ' THEN millestr[i] := '0';
  468.     END;
  469.    helpstr:=helpstr+millestr;
  470.    n := Length(helpstr);
  471.    IF n < minlength THEN helpstr := Chars(' ',minlength-n)+helpstr;
  472.  
  473.    FormattedLongIntStr := helpstr;
  474.   END;
  475. END;
  476.  
  477. (*------------------------------------------------------- Initialisation *)
  478.  
  479. PROCEDURE GetCountryInfo;
  480.  
  481. VAR Regs  : Registers;
  482.  
  483. BEGIN
  484.  WITH Regs DO
  485.   BEGIN
  486.    ah := $38; (* Get / Set Country Data *)
  487.    al := $00;
  488.    ds := Seg(Buffer); dx := Ofs(Buffer); (* Address of Buffer *)
  489.   END;
  490.  MsDos(Regs);
  491.  
  492.  IF Regs.Flags AND FCarry = 0 THEN
  493.   BEGIN
  494.    MilleSep := Buffer[ 7];
  495.    DateSep  := Buffer[11];
  496.    TimeSep  := Buffer[13];
  497.   END;
  498.  
  499.  CASE Ord(Buffer[0]) OF
  500.   0 : BEGIN
  501.        FormDate := FormDateUS;       DateFormat := 'mm'+DateSep+'dd'+DateSep+'yy';
  502.        FormTime := FormTime12;       TimeFormat := 'hh'+TimeSep+'mmp';
  503.       END;
  504.   1 : BEGIN
  505.        FormDate := FormDateEuropean; DateFormat := 'dd'+DateSep+'mm'+DateSep+'yy';
  506.        FormTime := FormTime24;       TimeFormat := 'hh'+TimeSep+'mm';
  507.       END;
  508.   2 : BEGIN
  509.        FormDate := FormDateJapanese; DateFormat := 'yy'+DateSep+'mm'+DateSep+'dd';
  510.        FormTime := FormTime24;       TimeFormat := 'hh'+TimeSep+'mm';
  511.       END;
  512.  ELSE
  513.   BEGIN
  514.    FormDate := FormDateEuropean;     DateFormat := 'dd'+DateSep+'mm'+DateSep+'yy';
  515.    FormTime := FormTime24;           TimeFormat := 'hh'+TimeSep+'mm';
  516.   END;
  517.  END; (* CASE *)
  518. END;
  519.  
  520. PROCEDURE EvaluateINIFileSettings;
  521.  
  522. VAR s : STRING[7];
  523.  
  524. BEGIN
  525.  IF INIFileExists THEN
  526.   BEGIN
  527.    MilleSep := ReadSettingsChar('date & time formats','millesep',MilleSep);
  528.    TimeSep  := ReadSettingsChar('date & time formats','timesep' ,TimeSep);
  529.    DateSep  := ReadSettingsChar('date & time formats','datesep' ,DateSep);
  530.  
  531.    s := ReadSettingsString('date & time formats','dateformat','ddmmmyy');
  532.    IF s = 'ddmmyy' THEN
  533.     BEGIN
  534.      FormDate := FormDateEuropean; DateFormat := 'dd'+DateSep+'mm'+DateSep+'yy';
  535.     END
  536.    ELSE
  537.    IF s = 'mmddyy' THEN
  538.     BEGIN
  539.      FormDate := FormDateUS;       DateFormat := 'mm'+DateSep+'dd'+DateSep+'yy';
  540.     END
  541.    ELSE
  542.    IF s = 'yymmdd' THEN
  543.     BEGIN
  544.      FormDate := FormDateJapanese; DateFormat := 'yy'+DateSep+'mm'+DateSep+'dd';
  545.     END
  546.    ELSE
  547.     BEGIN
  548.      FormDate := FormDateMyOwn;    DateFormat := 'ddmmmyy';
  549.     END;
  550.  
  551.    s := ReadSettingsString('date & time formats','timeformat','24');
  552.    IF s = '12' THEN
  553.     BEGIN
  554.      FormTime := FormTime12; TimeFormat := 'hh'+TimeSep+'mmp';
  555.     END
  556.    ELSE
  557.     BEGIN
  558.      FormTime := FormTime24; TimeFormat := 'hh'+TimeSep+'mm';
  559.     END;
  560.   END;
  561. END;
  562.  
  563. BEGIN
  564.  GetCountryInfo;
  565.  IF INIFileExists THEN EvaluateINIFileSettings;
  566. END.
  567.